COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	entry reginit,fregion,regterm,regclean
C00011 ENDMK
C⊗;
entry reginit,fregion,regterm,regclean;
begin "NFREG"
REQUIRE "36A" COMPILER!SWITCHES;
require "bufdec.sai" source!file;
external BOOLEAN PROCEDURE BORDER(INTEGER II,JJ,IBUF,OBUF; REFERENCE INTEGER imina,imaxa,jmina,jmaxa; integer value);
own integer reg,curreg,regbuf;
source!l(dynary);
require "⊂⊃<>" delimiters;
dynary(<SAFE integer>,<imina,imaxa,jmina,jmaxa,size>,1);




simple internal integer procedure reginit(integer maskbuf,sizarr);
    begin "reginit"
    integer i,j,iptr,rptr,state,fillnum,rowmax,colmax,ii,jj,totarr;
    if sizarr≤0 then sizarr←6;
    totarr←2↑sizarr;
    reg←0;

    makary(<(1,totarr)>,1,imina);
    makary(<(1,totarr)>,1,imaxa);
    makary(<(1,totarr)>,1,jmina);
    makary(<(1,totarr)>,1,jmaxa);
    makary(<(1,totarr)>,1,size);
    arrclr(size);
    totarr←totarr-1;

    getbuf(rowmax←rows(maskbuf),colmax←colms(maskbuf),sizarr,regbuf←fndbuf);
    putsub(isubst(maskbuf),jsubst(maskbuf),regbuf);


    for i←1 thru rowmax do
	begin "iloop"
	state←0;
	iptr←inptr(i,1,maskbuf);
	for j←1 thru colmax do
	    case state of
		begin "JCASE"
		if ildb(iptr)						! normal start state;
		    then begin "FOUND1"
			if (fillnum←getpnt(i,j,regbuf))=0
			    then begin
				if ¬border(i,j,maskbuf,regbuf,imina[reg←reg+1]←i,
				    imaxa[reg]←i,jmina[reg]←j,jmaxa[reg]←j,fillnum←reg)
				    then begin
					for ii←imina[reg] thru imaxa[reg] do
					    begin
					    dum←outptr(ii,jmina[reg],regbuf);
					    for jj←jmina[reg] thru jmaxa[reg] do
						if ildb(dum)=reg then dpb(0,dum);
					    end;
					jj←j;
					while (jj←jj-1)>0 do
					    if (fillnum←getpnt(i,jj,regbuf))
						then begin
						    state←2;
						    ifcr false thenc PRINT(">>"); endc
						    j←jj;
						    rptr←outptr(i,j+1,regbuf);
						    IPTR←INPTR(I,J+1,MASKBUF);
						    done;
						    end;
					reg←reg-1;
					continue;
					end;
				ifcr true thenc PRINT("#"); endc
				if (imaxa[fillnum]-imina[fillnum]<2)∧(jmaxa[fillnum]-jmina[fillnum]<2)
				    then begin
					border(i,j,maskbuf,regbuf,imina[reg]←i,
					    imaxa[reg]←i,jmina[reg]←j,jmaxa[reg]←j,0);
					state←3;
					reg←reg-1;
					ifcr true thenc PRINT("*"); endc
					end
				    else begin
					add1(size[fillnum]);
					state←1;
					rptr←outptr(i,j+1,regbuf);
					if reg=totarr then begin reg←totarr-1; PRINT("-"); end;
					end;
				end
			    else begin
				add1(size[fillnum]);
				state←1;
				rptr←outptr(i,j+1,regbuf);
				ifcr false thenc PRINT(">"); endc
				end;
			end;
		if ildb(rptr)=0						! checking for inside or outside of region;
		    then if ILDB(IPTR)
			then begin
			    state←2;
			    ifcr false thenc PRINT(">"); endc
			    dpb(fillnum,rptr);
			    add1(size[fillnum]);
			    end
			else begin
			    state←0;
			    ifcr false thenc PRINT("<"); endc
			    end
		    else BEGIN IBP(IPTR); add1(size[fillnum]); END;
		if ildb(rptr)						! filling in region;
		    then begin ifcr false thenc PRINT("<"); endc
			state←1;
			add1(size[fillnum]);
			IBP(IPTR);
			end
		    else begin
			IF ILDB(IPTR) THEN BEGIN
			    dpb(fillnum,rptr);
			    add1(size[fillnum]);
			    end
			  else begin
				border(i,j-1,maskbuf,regbuf,dum,dum,dum,dum,fillnum);
				STATE←0;
				END;
			end;
		if ildb(iptr)						! deletion of small region;
		    then dpb(0,iptr)
		    else state←0;
		end;
	ifcr false thenc PRINT("/"); elsec if (i MOD 10)=0 then PRINT("/"); endc
	end "iloop";
    IF SIZE[TOTARR]>0 THEN PRINT(CRLF,SIZE[TOTARR]," points skipped.",CRLF);
    return(reg);
    end "reginit";

simple internal integer procedure fregion(integer minsiz,bord);
    begin "fregion"
    integer i,j,maxi,maskb,ist,ilim,jst,jlim,iptr,optr;

    maxi←1;
    for i←1 thru reg do
	if size[i]>size[maxi]
	    then maxi←i;
    if size[maxi]<minsiz then return(-1);
    imina[maxi]←(imina[maxi]-bord) MAX 1;
    jmina[maxi]←(jmina[maxi]-bord) MAX 1;
    imaxa[maxi]←(imaxa[maxi]+bord) MIN rows(regbuf);
    jmaxa[maxi]←(jmaxa[maxi]+bord) MIN colms(regbuf);
    getbuf(ilim←imaxa[maxi]-imina[maxi]+1,jlim←jmaxa[maxi]-jmina[maxi]+1,1,maskb←fndbuf);
    putsub(ist←isubst(regbuf)+imina[maxi]-1,jst←jsubst(regbuf)+jmina[maxi]-1,maskb);

    putsup(size[maxi],maskb);
    for i←1 thru ilim do
	begin
	iptr←inptr(imina[maxi]+i-1,jmina[maxi],regbuf);
	optr←outptr(i,1,maskb);
	for j←1 thru jlim do
	    if ildb(iptr)=maxi then idpb(-1,optr) else ibp(optr);
	end;
    size[maxi]←-1;
    return(maskb);
    end "fregion";

simple internal procedure regterm;
    begin
    frebuf(regbuf);
    relary(<(imina,jmina,imaxa,jmaxa,size)>);
    end;

SIMPLE INTERNAL INTEGER PROCEDURE REGCLEAN (INTEGER MINSIZ);
	BEGIN "REGCLEAN"
	INTEGER ROWZ,COLZ,I,J,MASKB,IPTR,OPTR;

	GETBUF(ROWZ←rows(regbuf),COLZ←colms(regbuf),1,MASKB←FNDBUF);
	PUTSUB(ISUBST(REGBUF),JSUBST(REGBUF),maskb);
	FOR I←1 THRU ROWZ DO
		BEGIN
		IPTR←INPTR(I,1,REGBUF);
		OPTR←OUTPTR(I,1,MASKB);
		FOR J←1 THRU COLZ DO
		    IF (DUM←ILDB(IPTR))
			then IF SIZE[DUM]≥MINSIZ
			    then IDPB(-1,OPTR)
			    ELSE IBP(OPTR)
			else ibp(optr);
		END;
	j←0;
	for i←1 thru reg do if size[i]≥minsiz then j←j+size[i];
	putsup(j,maskb);
	RETURN(MASKB);
	END "REGCLEAN";
end "NFREG";